home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / globe.arc / GLOBE.BAS next >
Encoding:
BASIC Source File  |  1983-08-26  |  3.6 KB  |  113 lines
  1. 10 ''Real Time Perspective Image of Rotated Globe
  2. 20 '
  3. 30 'Original program by: Karl Koessel
  4. 40 '
  5. 50 'Animation by: Andrew Tuline
  6. 60 '
  7. 70 'This program has been modified from the original submitted to
  8. 80 'PCWORLD magazine. The initialization draws 5 different images
  9. 90 'and stores the array for each image to disk. This process requires
  10. 100 'about 15 minutes. The data file GLOBE.DAT is stored to disk.
  11. 110 'The program checks for this data file, and if not available, will
  12. 120 'create one. Once this file has been created, the program will load
  13. 130 'it into the corresponding arrays, and will display a realtime rotating
  14. 140 'globe in the Screen 2 mode. The globe occupies a small section of the
  15. 150 'screen and shows best results when used with an RGB monitor. This seems
  16. 160 'a good example of non-flickering graphics in Basic.
  17. 170 '
  18. 180 '
  19. 190 SCREEN 2:CLS:KEY OFF:DEFINT L,R,X-Z
  20. 200 DIM RC(11),A%(380),B%(380),C%(380),D%(380),E%(380)
  21. 210 ON ERROR GOTO 1100
  22. 220 OPEN "GLOBE.DAT" FOR INPUT AS #1
  23. 230 FOR I=0 TO 380:INPUT #1,A%(I):NEXT
  24. 240 FOR I=0 TO 380:INPUT #1,B%(I):NEXT
  25. 250 FOR I=0 TO 380:INPUT #1,C%(I):NEXT
  26. 260 FOR I=0 TO 380:INPUT #1,D%(I):NEXT
  27. 270 FOR I=0 TO 380:INPUT #1,E%(I):NEXT
  28. 275 CLS
  29. 280 PUT (320,100),A%,PSET
  30. 290 PUT (320,100),B%,PSET
  31. 300 PUT (320,100),C%,PSET
  32. 310 PUT (320,100),D%,PSET
  33. 320 PUT (320,100),E%,PSET
  34. 330 A$=INKEY$:IF A$="" THEN 280 ELSE END
  35. 340 OPEN "GLOBE.DAT" FOR OUTPUT AS #1
  36. 350 CX=CY:CZ=SX:SY=SZ:I=J:R=A:B=C:A1=B2:C1=C2
  37. 360 A3=B3:X=Y:XC=YC:LX=LY:B$=C$:RC=PI:LZ=ZS:Q=DR
  38. 370 FOR X=1 TO 11
  39. 380      RC(X)=(X-1)MOD 3+1
  40. 390     IF X>6 THEN RC(X)=(5-RC(X))MOD 3+1
  41. 400 NEXT
  42. 410 PI=3.14159265#
  43. 420 CF=PI/180#
  44. 430 GOSUB 1030
  45. 440 FOR YROT=120 TO 132 STEP 3
  46. 450 GOSUB 530
  47. 460 GET (265,73)-(373,126),A%
  48. 470 FOR I=0 TO 380:PRINT #1,A%(I):NEXT
  49. 480 NEXT
  50. 490 BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP
  51. 500 CLOSE #1
  52. 510 A$=INKEY$:IF A$<>"" THEN 510
  53. 520 GOTO 220
  54. 530 CX=COS(CF*XROT+ATN(YOBS/ZOBS)):SX=SIN(CF*XROT+ATN(YOBS/ZOBS))
  55. 540 CY=COS(CF*YROT+ATN(XOBS/ZOBS)):SY=SIN(CF*YROT+ATN(XOBS/ZOBS))
  56. 550 CZ=COS(CF*ZROT):SZ=SIN(CF*ZROT)
  57. 560 ZOBS=SQR(XOBS^2+YOBS^2+ZOBS^2)
  58. 570 ZS=R^2/ZOBS
  59. 580 CLS
  60. 590 LOCATE 1,1:PRINT"Initializing GLOBE.DAT. 5 beeps will sound upon completion"
  61. 600 LOCATE 5,5:PRINT USING "Picture # of 5";(YROT-117)/3
  62. 610 FOR I=0 TO 3 STEP PI/12
  63. 620     RC=(I*12/PI+2)MOD 3+1
  64. 630     C$=STR$(RC)
  65. 640     C$="3"
  66. 650     FOR J=0 TO 2.0001*PI STEP PI/24
  67. 660             A=R*SIN(I)*SIN(J)
  68. 670             B=R*COS(J)
  69. 680             C=R*COS(I)*SIN(J)
  70. 690             GOSUB 860
  71. 700             GOSUB 960
  72. 710     NEXT
  73. 720 NEXT
  74. 730 FOR I=PI/12 TO 11*PI/12 STEP PI/12
  75. 740     RC=RC(I*12/PI)
  76. 750     C$=STR$(RC)
  77. 760     C$="3"
  78. 770     FOR J=0 TO 2.0001*PI STEP PI/24
  79. 780             A=R*SIN(I)*SIN(J)
  80. 790             B=R*COS(I)
  81. 800             C=R*SIN(I)*COS(J)
  82. 810             GOSUB   860
  83. 820             GOSUB 960
  84. 830     NEXT
  85. 840 NEXT
  86. 850 RETURN
  87. 860 A1=A*CY-C*SY
  88. 870 C1=A*SY+C*CY
  89. 880 B2=B*CX-C1*SX
  90. 890 C2=B*SX+C1*CX
  91. 900 A3=A1*CZ-B2*SZ
  92. 910 B3=A1*SZ+B2*CZ
  93. 920 DR=C2/(ZOBS-C2)+1
  94. 930 X=INT(A3*DR*ASP+XC)
  95. 940 Y=INT(B3*-DR+YC)
  96. 950 RETURN
  97. 960 IF C2<ZS OR LZ<ZS THEN B$="BC":GOTO 990
  98. 970 Q=(X<0)+(X>639)+(Y<0)+(Y>199)+(LX<0)+(LX>639)+(LY<0)+(LY>199)
  99. 980 IF Q+(J=0) THEN B$="BC" ELSE B$="C"
  100. 990 LX=X:LY=Y
  101. 1000 LZ=C2
  102. 1010 DRAW B$+C$+"M"+STR$(X)+","+STR$(Y)
  103. 1020 RETURN
  104. 1030 XC=320:YC=100
  105. 1040 XOBS=-9:YOBS=0:ZOBS=456
  106. 1050 XROT=37:ZROT=23:'YROT=-123
  107. 1060 R=25
  108. 1070 BCK=1:PAL=1
  109. 1080 ASP=2
  110. 1090 RETURN
  111. 1100 IF ERR<>53 THEN PRINT"error":END
  112. 1110 RESUME 340
  113.